perm filename PROTX[E,ALS] blob sn#189269 filedate 1975-12-04 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	Code to report protection and to allow it to be changed.
C00005 ENDMK
CāŠ—;
;Code to report protection and to allow it to be changed.
PROTEC:	SETZM PROTEF#		;Used as flag and to hold A value
	MOVE T,EXTPNT		;Data already gobbled into EXTBUF by EXTEND
	MOVEM T,TYIPNT
	HRLI C,(<MOVEI C,>)
	MOVEM C,TYIINS
	PUSHJ P,TYI
	JRST PROTE4		;Report only
	TRNE F,REDNLY
	JRST PROTE2		;Do not change if in readonly
	MOVEI A,0
	MOVEI B,3
	SETOM PROTEF		;Anticipate change
PROTE0:	CAIG C,71
	CAIGE C,60
	SETZM PROTEF		;No, can not change after all
	LSH A,3
	ADDI A,-"0"(C)
	PUSHJ P,TYI
	JRST PROTE4		;Last character found
	SOJG B,PROTE0
	SETZM PROTEF		;Too many characters so ignore
PROTE1:	OUTSTR [ASCIZ / Only 3 octal digits allowed. /]
	JRST PROTE4

PROTE2:	OUTSTR [ASCIZ / Cannot be changed in READONLY mode. /]
	SETZM PROTEF
	JRST PROTE4

PROTE3:	OUTSTR [ASCIZ / Rename failure /]
	DPB T,[331100,,EDFIL+2]	;Restore old valuee
	HRRZ T,EDFIL+1
	MOVE A,[440700,,C]
	PUSHJ P,OCTSTR
	OUTSTR C
	MOVEI E,EDFIL
	PUSHJ P,OPENW		;Rename failure closes this file
	JRST PROTEX

PROTE4:	SKIPE PROTEF
	MOVEM A,PROTEF		;Save value temporarily
	OUTSTR [ASCIZ /
Protection key /]
	SETZM TYOPNT
	LDB T,[331100,,EDFIL+2]
	PUSHJ P,OCT3ST
	OUTSTR C
	TYPCHR " "
	SKIPN A,PROTEF
	JRST PROTEX
	HLLZS EDFIL+1
	LDB T,[331100,,EDFIL+2]	;Save for rename failure situation
	SETZM EDFIL+2
	SKIPN EDFIL
	JRST PROTE3		;To prevent deletion if bug exists
	DPB A,[331100,,EDFIL+2]
	RENAME DSKO,EDFIL
	JRST PROTE3		;Something is wrong
	OUTSTR [ASCIZ / changed to /]
	LDB T,[331100,,EDFIL+2]
	PUSHJ P,OCT3ST
	OUTSTR C
PROTEX:	SETZM TYIPNT
	JRST PPJ1CR